module Menu2 where 

import Addressbook
import Data.Char
import System.IO
import System.Directory
import Data.Time.Clock
import Data.Time.Calendar

--skrótowa funkcja do wywoływania głównej pętli
main = do menuLoop (DB [] [])

-- ---- GŁÓWNA PĘTLA PROGRAMU ----------------------------------
-- wczytuje wybory użytkownika i pozwala podjąć odpowiednie operacje na danych po wykonaniu których znowu jest wywoływana
menuLoop (DB c g) = do putStrLn "=============================================================="
                       putStrLn "======= Ksiazka adresowa = Menu glowne ======================="
                       putStrLn "=============================================================="
                       putStrLn "1  Zarzadzanie kontaktami"
                       putStrLn "2  Zarzadzanie grupami"
                       putStrLn "3  Wyszukiwanie"
                       putStrLn "4  Kto ma dzisiaj urodziny"
                       putStrLn "5  Zapis danych do pliku"
                       putStrLn "6  Wczytanie danych z pliku"
                       putStrLn "0  Wyjscie"
                          
                       cmd <- getLineNoPipe
                         
                       case cmd of "1" -> do manageContacts (DB c g)
                                   "2" -> do manageGroups   (DB c g)
                                   "3" -> do find           (DB c g)
                                   "4" -> do whereIsParty   (DB c g)
                                   "5" -> do saveData       (DB c g)
                                   "6" -> do loadData       (DB c g)
                                   "0" -> do putStrLn       "Koniec."
                                   otherwise -> do putStrLn "Nieprawidlowy nr opcji"
                                                   menuLoop (DB c g)

-- ---- ZARZADZANIE KONTAKTAMI ---------------------------------
manageContacts (DB c g) = do putStrLn "=============================================================="
                             putStrLn "======= Ksiazka adresowa = Zarzadzanie kontaktami ============"
                             putStrLn "=============================================================="
                             putStrLn "1  Wyswietl kontakty"
                             putStrLn "2  Dodaj kontakt"
                             putStrLn "3  Edytuj kontakt"
                             putStrLn "4  Usun kontakt"
                             putStrLn "0  Wroc"
         
                             cmd <- getLineNoPipe
         
                             case cmd of "1" -> do menuShowContacts     (DB c g)
                                         "2" -> do menuInsertContact    (DB c g)
                                         "3" -> do menuUpdateContact    (DB c g) 
                                         "4" -> do menuDeleteContact    (DB c g)
                                         "0" -> do menuLoop             (DB c g)
                                         otherwise -> do putStrLn       "Nieprawidlowy nr opcji"
                                                         manageContacts (DB c g)

-- ---- ZARZADZANIE GRUPAMI ------------------------------------
manageGroups (DB c g) = do putStrLn "=============================================================="
                           putStrLn "======= Ksiazka adresowa = Zarzadzanie grupami ==============="
                           putStrLn "=============================================================="
                           putStrLn "1  Wyswietl grupy"
                           putStrLn "2  Dodaj grupe"
                           putStrLn "3  Edytuj nazwe grupy"
                           putStrLn "4  Scal grupy"
                           putStrLn "5  Zarzadzaj czlonkami grupy"
                           putStrLn "6  Usuń grupe"
                           putStrLn "0  Wroc"
         
                           cmd <- getLineNoPipe
         
                           case cmd of "1" -> do menuShowGroups     (DB c g)
                                       "2" -> do menuAddGroups      (DB c g)
                                       "3" -> do menuUpdateGroups   (DB c g)
                                       "4" -> do menuSumGroups      (DB c g)
                                       "5" -> do menuManageMembers  (DB c g)
                                       "6" -> do menuDeleteGroups   (DB c g)
                                       "0" -> do menuLoop           (DB c g)
                                       otherwise -> do putStrLn     "Nieprawidlowy nr opcji"
                                                       manageGroups (DB c g)
        
-- ---- SZUKAJKI -----------------------------------------------
find (DB c g) = do putStrLn "=============================================================="
                   putStrLn "======= Ksiazka adresowa = Szukajki =========================="
                   putStrLn "=============================================================="
                   putStrLn "1  Znajdź kontakt po ..."
                   putStrLn "2  Znajdź czlonkow grupy"
                   putStrLn "0  Wroc"
         
                   cmd <- getLineNoPipe
         
                   case cmd of "1" -> do findContact    (DB c g)
                               "2" -> do findMembers    (DB c g)
                               "0" -> do menuLoop       (DB c g)
                               otherwise -> do putStrLn "Nieprawidlowy nr opcji"
                                               find     (DB c g)

-- ---- KONTAKTY -----------------------------------------------

menuShowContacts (DB c g) = do putStrLn ( contactsToString c )
                               manageContacts (DB c g)
 
menuInsertContact (DB c g) = do putStrLn "=============================================================="
                                putStr "Podaj imie: "
                                name <- getLineNoPipe
                                putStr "Podaj nazwisko: "
                                surname <- getLineNoPipe
                                putStr "Podaj firmę: "
                                company <- getLineNoPipe
                                phone <- loadPhoneNumber                                
                                mail <- loadMail                           
                                birthday <- loadDate
                                manageContacts (DB ( insertContact c name surname company phone mail birthday ) g )
-- funkcja wczytująca zwalidowany numer telefonu który musi być liczbą                                
loadPhoneNumber =    do putStr "Podaj numer telefonu: "
                        phone <- getLineNoPipe 
                        if (isNumberFromString phone) 
                        then return phone
                        else do
                             putStr "Podany został niepoprawny numer telefonu. Numer telefonu może być złożony tylko z liczb. "
                             loadPhoneNumber
--funkcja wczytująca zwalidowaną datę, która składa się z 3 liczb oddzielonych myślnikami z odopowiednich przedziałów                              
loadDate =          do  putStr "Podaj datę urodzenia w foramcie dd-mm-rrrr: "
                        date <- getLineNoPipe
                        if ((numberOfDashes date)==2) 
                        then  let items = (split "-" date) in
                              if ((isDayCorrect (items!!0))&&(isMonthCorrect (items!!1))&&(isYearCorrect (items!!2)))
                              then return date
                              else do
                                   putStr "Podana została nieprawidłowa data. "
                                   loadDate
                        else do
                             putStr "Podana została nieprawidłowa data. Kolejne liczby należy oddzielić myślnikami. "
                             loadDate
-- funkcja wczytująca zwalidowany adres e-mail czyli string który zawieta @                             
loadMail=       do      putStr "Podaj adres e-mail: "
                        mail <- getLineNoPipe
                        if ((numberOfAt mail)==1)
                        then return mail
                        else do
                             putStr "Podany został nieprawidłowy adres e-mail. "
                             loadMail 
                                
menuUpdateContact (DB c g) = do putStrLn "=============================================================="
                                putStr "Podaj id: "
                                contactId <- getLineNoPipe
                                putStr "(i)mie (n)azwisko (f)irma (t)elefon (m)ail (u)rodziny: "
                                what <- getLineNoPipe
                                putStr "Podaj nowa wartość: "
                             
                               
                                case what of "i" -> do value <- getLineNoPipe 
                                                       manageContacts (DB (updateContact' c ( read contactId :: Int ) NAME value ) g )
                                             "n" -> do value <- getLineNoPipe 
                                                       manageContacts (DB (updateContact' c ( read contactId :: Int ) SURNAME value ) g )
                                             "f" -> do value <- getLineNoPipe 
                                                       manageContacts (DB (updateContact' c ( read contactId :: Int ) COMPANY value ) g )
                                             "t" -> do value <- loadPhoneNumber 
                                                       manageContacts (DB (updateContact' c ( read contactId :: Int ) PHONE value ) g )
                                             "m" -> do value <- loadMail  
                                                       manageContacts (DB (updateContact' c ( read contactId :: Int ) MAIL value ) g )
                                             "u" -> do value <- loadDate 
                                                       manageContacts (DB (updateContact' c ( read contactId :: Int ) BIRTHDAY value ) g )
                                             otherwise -> do putStrLn   "Nieprawidlowy nr opcji"
                                                             menuUpdateContact ( DB c g )
                               
                                 
menuDeleteContact (DB c g) = do putStrLn "=============================================================="
                                putStr "Podaj id kontaktu: "
                                contactId <- getLineNoPipe
                                manageContacts ( DB ( deleteContact c ( read contactId :: Int ) ) g )        

-- ---- GRUPY -----------------------------------------------

                                 
menuShowGroups (DB c g) = do putStrLn "=============================================================="
                             putStrLn ( groupsToString g )
                             manageGroups ( DB c g )  

menuAddGroups (DB c g) = do putStrLn "=============================================================="
                            putStr "Podaj nazwe grupy: "
                            groupName <- getLineNoPipe
                            manageGroups ( DB c ( insertGroup g groupName ) )
                             
menuUpdateGroups (DB c g) = do putStrLn "=============================================================="
                               putStr "Podaj id: "
                               newGroupId <- getLineNoPipe
                               putStr "Podaj nowa nazwe grupy: "
                               newName <- getLineNoPipe
                               manageGroups ( DB c ( updateGroup g ( read newGroupId :: Int ) newName ) )
                             
menuSumGroups (DB c g) = do putStrLn "=============================================================="
                            putStr "Podaj pierwsze id: "
                            firstId <- getLineNoPipe
                            putStr "Podaj drugie id: "
                            secondId <- getLineNoPipe
                            putStr "Podaj nowa nazwe grupy: "
                            newName <- getLineNoPipe
                            manageGroups ( DB c ( sumGroup g ( read firstId :: Int ) ( read secondId :: Int ) newName ) )
                             
menuManageMembers (DB c g) = do putStrLn "=============================================================="
                                putStrLn "======= Ksiazka adresowa = Zarzadzanie grupami = Czlonkowie =="
                                putStrLn "=============================================================="
                                putStrLn "1  Pokaz czlonkow"
                                putStrLn "2  Dodaj czlonka"
                                putStrLn "3  Usun czlonka"
                                putStrLn "0  Powrot"
         
                                cmd <- getLineNoPipe
         
                                case cmd of "1" -> do menuShowMembers  (DB c g)
                                            "2" -> do menuAddMember    (DB c g)
                                            "3" -> do menuDeleteMember (DB c g)
                                            "0" -> do manageGroups     (DB c g)
                                            otherwise -> do putStrLn "Nieprawidlowy nr opcji"
                                                            menuManageMembers (DB c g)
                             
menuShowMembers (DB c g) = do putStrLn "==============================================================" 
                              putStr "Podaj id grupy: "
                              grId <- getLineNoPipe
                              putStrLn ( showMembers c g ( read grId :: Int ) )
                              menuManageMembers (DB c g)
       
menuAddMember (DB c g) = do putStrLn "==============================================================" 
                            putStr "Podaj id grupy: "
                            grId <- getLineNoPipe
                            putStr "Podaj id czlonka do dodania: "
                            contId <- getLineNoPipe
                            menuManageMembers ( DB c ( addMemeber g ( read grId :: Int ) ( read contId :: Int ) ) )

menuDeleteMember (DB c g) = do putStrLn "=============================================================="
                               putStr "Podaj id grupy: "
                               grId <- getLineNoPipe
                               putStr "Podaj id czlonka do usuniecia: "
                               contId <- getLineNoPipe
                               menuManageMembers ( DB c ( removeMembers g ( read grId :: Int ) ( read contId :: Int ) ) )
                                                            
menuDeleteGroups (DB c g) = do putStrLn "=============================================================="
                               putStr "Podaj id grupy do usuniecia: "
                               grId <- getLineNoPipe
                               manageGroups ( DB c ( deleteGroup g ( read grId :: Int ) ) )

--  ---- SZUKAJKI -----------------------------------------------
                             
findContact (DB c g) = do putStrLn "=============================================================="
                          putStrLn "Po czytm chcesz wysszukiwac?"
                          putStr "(i)mie (n)azwisko (f)irma (t)elefon (m)ail (u)rodziny: "
                          what <- getLineNoPipe
                          putStr "Wprowadz wartosc: "
                          value <- getLineNoPipe
                          
                          case what of "i" -> do putStrLn ( contactsToString ( findBy NAME c value ) )
                                       "n" -> do putStrLn ( contactsToString ( findBy SURNAME c value ) )
                                       "f" -> do putStrLn ( contactsToString ( findBy COMPANY c value ) )
                                       "t" -> do putStrLn ( contactsToString ( findBy PHONE c value ) )
                                       "m" -> do putStrLn ( contactsToString ( findBy MAIL c value ) )
                                       "u" -> do putStrLn ( contactsToString ( findBy BIRTHDAY c value ) )
                                       otherwise -> do putStrLn   "Nieprawidlowy nr opcji"
                                                       findContact ( DB c g )
                                                       
                          find (DB c g)

                          
                             
findMembers (DB c g) = do putStrLn "=============================================================="
                          putStr "Wprowadz nazwe: "
                          name <- getLineNoPipe
                          putStrLn ( listFindMemebersGroups c g ( getGroupByName g name ) )
                          find ( DB c g )
                          
    
-- OPERACJE NA PLIKACH -----------------------------------------------
-- funkcja zapisująca wszystkie zgromadzone dane do 2 plików: groups.txt i contacts.txt w lokalizacji wskazanej przez użytkownika
saveData (DB c g)= do putStrLn "=============================================================="
                      putStrLn "===================== Zapis do pliku ========================="
                      putStrLn "=============================================================="
                      putStrLn "1  Zapisz pliki w bieżącym katalogu"
                      putStrLn "2  Wprowadź ścieżkę do katalogu zapisu"
                      putStrLn "0  Wróć"
                      
                      cmd <- getLineNoPipe         
                      case cmd of "1" -> do saveDataWithPath (DB c g) "contacts.txt" "groups.txt"
                                  "2" -> do putStr "Wpisz ścieżkę zapisu: "
                                            path <- getLineNoPipe
                                            saveDataWithPath (DB c g) (path++"contacts.txt") ("path++groups.txt")
                                  "0" -> do menuLoop           (DB c g)
                      do menuLoop           (DB c g)
-- funkcja pomocnicza do zapisywania                                  
saveDataWithPath (DB c g) pathContacts pathGroups= do saveRecordsToContacts pathContacts c
                                                      saveRecordsToGroups pathGroups g
                                                      putStrLn "Dane zostały zapisane"
                                                                                  
                                  
-- funkcja wczytująca wszystkie zgromadzone dane z 2 plików: groups.txt i contacts.txt z lokalizacji wskazanej przez użytkownika                                 
loadData (DB c g)= do putStrLn "=============================================================="
                      putStrLn "================== Wczytywanie z pliku ====+=================="
                      putStrLn "=============================================================="
                      putStrLn "1  Wczytaj z plików z bieżącego katalogu"
                      putStrLn "2  Wprowadź ścieżkę katalogu plików z danymi"
                      putStrLn "0  Wróć"
                      
                      cmd <- getLineNoPipe         
                      case cmd of "1" -> do loadDataWithPath (DB c g) "contacts.txt" "groups.txt"
                                  "2" -> do putStr "Wpisz ścieżkę zapisu: "
                                            path <- getLineNoPipe
                                            loadDataWithPath (DB c g) (path++"contacts.txt") ("path++groups.txt")
                                  "0" -> do menuLoop           (DB c g)
-- funckcja pomocnicza do wczytywania                                 
loadDataWithPath (DB c g) pathContacts pathGroups= do r1 <- (doesFileExist pathContacts);        
                                                      r2 <- (doesFileExist pathGroups);                               
                                                      if(((show r1)=="True")&&((show r2)=="True")) then do tempc <- readContacts pathContacts
                                                                                                           tempg <- readGroups pathGroups
                                                                                                           putStrLn "Dane zostały wczytane"
                                                                                                           menuLoop (DB tempc tempg)
                                                                                                   else do putStrLn "Pliki w podanej lokalizacji nie istnieją."
                             

-- ---- bezpośredni zapis do pliku -----------------------------------------------
--funkcje bezpośrednio zapisujące do pliku: zapisywane jest wczystko w postaci Stringów w 2 plikach (jeden wiersz to jeden rekord)
saveRecordsToContacts pathContacts contacts  = do
                                        handler <- openFile pathContacts WriteMode
                                        hPutStr handler (contactsToString' contacts)
                                        hClose handler

saveRecordsToGroups pathGroups groups = do 
                                        handler <- openFile pathGroups WriteMode
                                        hPutStr handler (groupsToString' groups)                                        
                                        hClose handler



-- ---- bezpośrednie wczytywanie z pliku -----------------------------------------------
-- funckje bezpośrednio wczytujące z plików, wczytywanie odbywa się linia po lini z plików tekstowych, linie Stringów są odpowiednio przeparsowywane 
-- na właściwe typy danych oraz wstawiane do struktur istniejących w programie za pomocą odpowiednich metod
readContacts pathContacts  = do
                                        handler <- openFile pathContacts ReadMode
                                        tempContacts <- readContact handler []
                                        hClose handler
                                        return tempContacts
--funkcja wczytująca jeden wiersz z pliku tekstowego
readContact handler contacts = do {                          t <- hIsEOF handler;                                                                                                      
                                                        if t then return contacts
                                                        else do {
                                                                contents <- hGetLine handler;
                                                                x<-return(contents);
                                                                y<-return(length x);
                                                                if x == [] then return contacts
                                                                else do {                                                                                 
                                                                                        let 
                                                                                           line = (split "|" x);                                                                                          
                                                                                           in readContact handler (insertContact' contacts (stringToInt (line!!0)) (line!!1) (line!!2) (line!!3) (line!!4) (line!!5) (line!!6) );
                                                                        }
                                                                }
                                                                
                                                        }
                                                        
readGroups pathGroups = do
                                        handler <- openFile pathGroups ReadMode
                                        tempGroups <- readGroup handler [] 
                                        hClose handler
                                        return tempGroups
--funkcja wczytująca jeden wiersz z pliku tekstowego
readGroup handler groups  = do {                          t <- hIsEOF handler;                                                                                                      
                                                        if t then return groups
                                                        else do {
                                                                contents <- hGetLine handler;
                                                                x<-return(contents);
                                                                y<-return(length x);
                                                                if x == [] then return groups
                                                                else do {     
                                                                                        let 
                                                                                           line = (split "|" x);
                                                                                           in readGroup handler (insertGroup' groups (stringToInt (line!!0)) (line!!1) (stringToIntArray (line!!2)) );                                                                                                                                                               
                                                                                        
                                                                        }
                                                                }
                                                                
                                                        }


-- ---- KTO MA DZISIAJ URODZINY -----------------------------------------------

date :: IO (Integer,Int,Int) -- :: (year,month,day)
date = getCurrentTime >>= return . toGregorian . utctDay



whereIsParty (DB c g) = do
                            (year, month, day) <- date
                            let strDate = show day ++ "-" ++ show month ++ "-" ++ show year
                            putStrLn ( whereIsPartyCheck c strDate )
                            menuLoop (DB c g)

whereIsPartyCheck :: [Contact] -> String -> String
whereIsPartyCheck [] _ = ""
whereIsPartyCheck [x] date1 = if (compareBirthday (split "-" ( getContactBirthday x ) ) (split "-" date1) ) then (contactToString x)
                                                                                              else ""
whereIsPartyCheck (x:xs) date1 = whereIsPartyCheck [x] date1 ++ whereIsPartyCheck xs date1

compareBirthday :: [String] -> [String] -> Bool
compareBirthday (x1:y1:z1) (x2:y2:z2) = ( ( (read x1 :: Int) == (read x2 :: Int) ) && ( ( read y1 :: Int)  == ( read y2 :: Int) ) )

-- FUNKCJE POMOCNICZE -----------------------------------------------
isNumberFromString [] = False
isNumberFromString [x] = if isDigit x then True else False
isNumberFromString (x:xs) = if isDigit x then isNumberFromString xs else False

numberOfDashes [] =0
numberOfDashes [x]=if ([x] =="-") then 1 else 0
numberOfDashes (x:xs)= if ([x] =="-") then 1+(numberOfDashes xs) else numberOfDashes xs

numberOfAt [] =0
numberOfAt [x]=if ([x] =="@") then 1 else 0
numberOfAt (x:xs)= if ([x] =="@") then 1+(numberOfAt xs) else numberOfAt xs
                                                         
stringToInt [] = 0
stringToInt [x] | isDigit x == True = digitToInt x
               | otherwise = 0
stringToInt (x:xs) | isDigit x == True = 10^length xs * digitToInt x + stringToInt xs
                  | otherwise = 0
--funkcja zamieniająca string np "[1,2,4]" na tablicę intów
stringToIntArray [] = []
stringToIntArray s = let items=split "," (tail (init s))
                            in arrayStringToArrayInt items
                                                
-- funkcja zamienia tablicę stringów na tablicę intów
arrayStringToArrayInt :: [String] -> [Int]
arrayStringToArrayInt [] = []
arrayStringToArrayInt [x] = [stringToInt x]
arrayStringToArrayInt (x:xs) = [stringToInt x] ++ arrayStringToArrayInt xs
                                                        
isDayCorrect day = if ((stringToInt day) > 0) && ((stringToInt day) < 32) then True else False


isMonthCorrect month = if ((stringToInt month) > 0) && ((stringToInt month) < 13) then True else False
                       

isYearCorrect year = if ((stringToInt year) > 1800) && ((stringToInt year) < 2014) then True else False
-- dzieli string y na podstawie argumentu x
split :: Eq a => [a] -> [a] -> [[a]]
split x y = func x y [[]]
    where
        func x [] z = reverse $ map (reverse) z
        func x (y:ys) (z:zs) = if ( take (length x) (y:ys) ) == x
                             then func x (drop (length x) (y:ys)) ([]:(z:zs))
                             else func x ys ((y:z):zs)
                                                         
-- funkcja nie pozwalająca wczytać | użytkownikowi, gdyż jest on wykorzystywany do oddzielenia danych w zapisanym pliku
getLineNoPipe = do line <- getLine
                   if (hasPipe line) 
                        then do putStr "Wprowadzone dane nie mogą zawierać znaku |. Wprowadź daną ponownie: "
                                getLineNoPipe
                        else return line

--funkcja do sprawdzania czy String ma |
hasPipe [] =False
hasPipe [x]=if ([x] =="|") then True else False
hasPipe (x:xs)= if ([x] =="|") then True else (hasPipe xs)
                                                 